home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pull55.zip / PULLSHEL.ZIP / PULLDATA.PAS next >
Pascal/Delphi Source File  |  1989-08-24  |  11KB  |  318 lines
  1. { =========================================================================== }
  2. { PullData.pas - User Statistics for data-entry windows.    ver 5.5, 08-24-89 }
  3. {                                                                             }
  4. { This file contains all the data to configure the data-entry fields in       }
  5. { data windows or work windows.                                               }
  6. {   Copyright (c) 1987-1989 James H. LeMay, All rights reserved.              }
  7. { =========================================================================== }
  8.  
  9. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }         { TP4 directives }
  10. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}    { TP5 directives }
  11.  
  12. {$define UseMsgLineCode }
  13.  
  14. UNIT PullData;
  15.  
  16. INTERFACE
  17.  
  18. uses
  19.   Crt,Qwik,Strs,Wndw,Pull,PullStat;
  20.  
  21. { ================ Set up variables for data windows here: ================== }
  22. { Place your variables names here to interface with the menus.                }
  23. { Careful! -- there's NO type checking for parameters in Transfer.  You MUST  }
  24. { be certain case statement, DataWndw, and TypeOfData all match.  Be          }
  25. { especially careful of string lengths that are too long.  They can be no     }
  26. { longer than DataStrSize.                                                    }
  27. { --------------------------------------------------------------------------- }
  28.  
  29. const
  30.   aByte:    byte    = 100;
  31.   aInteger: integer = 200;
  32.  
  33. type
  34.   { Work window data entry names. }
  35.   DataEntryNames = (NoDE,aIntegerDE);
  36.  
  37. var
  38.   DataEntryOattr,          { Output attribute }
  39.   DataEntryIattr,          { Input  attribute }
  40.   DataWndwIattr,           { Input  attribute }
  41.   DataWndwOattr,           { Output attribute }
  42.   DataWndwBattr:  byte;    { Border attribute }
  43.   DataWndwBrdr:   Borders;
  44.  
  45.  
  46. IMPLEMENTATION
  47.  
  48. { ================ Set up your Error Message Lines here: ================== }
  49. { Error Messages are used for indicating that data entry was invalid or out }
  50. { of range.  ErrMsgLine[1] is reserved for custom error messages that you   }
  51. { can create at runtime.  Messages up to InvalidEM are reserved and must    }
  52. { match those in PULL.PAS.                                                  }
  53. { ------------------------------------------------------------------------- }
  54. type
  55.   ErrMsgNames = (NoEM,UserEM,InvalidEM,MyEM);
  56.  
  57. {$ifdef UseMsgLineCode }
  58. procedure GetErrMsgs;
  59. begin
  60.   AutoNumLock := false;   { If true, turns on NumLock on with data entry }
  61.   CapsLockCol := 41;      { First column for ' CAPS NUM SCROLL ' on MsgLine. }
  62.  
  63.   ErrMsgLine[ord(InvalidEM)]:=' Invalid entry.             ESC-acknowledge';
  64.   ErrMsgLine[ord(MyEM)]     :=' This indicates an error.   ESC-acknowledge';
  65. end;
  66.  
  67. {$endif UseMsgLineCode }
  68.  
  69. procedure MakeErrMsg (Low,High: longint);
  70. begin
  71.   {$ifdef UseMsgLineCode }
  72.   DataPad.ErrMsg := ord(UserEM);
  73.   ErrMsgLine[ord(UserEM)] :=
  74.     'Range: '+StrL(Low)+' to '+StrL(High)+'.  Press ESC';
  75.   {$endif }
  76. end;
  77.  
  78. { ====================== Data Entry Range Checking ========================== }
  79. { These procedures are completely defined by the user.  They may not even be  }
  80. { necessary if the string entered is satisfactory as a valid number.  The     }
  81. { calls must be forced to FAR because they are called indirectly.             }
  82. { "Translate" can alter each key from the keyboard before it gets evaluated.  }
  83. { "Verify" will check the range or even completely alter the entire string.   }
  84. { --------------------------------------------------------------------------- }
  85.  
  86. { -------------------- Data Window Data Entry Checking ---------------------- }
  87. {$F+}
  88. procedure CheckAbyte;
  89. begin
  90.   with DataPad do
  91.     if ((Bdata<20) or (Bdata>50)) then
  92.       MakeErrMsg (20,50);
  93. end;
  94.  
  95. { -------------------- Work Window Data Entry Checking ---------------------- }
  96.  
  97. procedure TranslateCase;
  98. begin
  99.   if not ExtKey then
  100.     Key := upcase(Key);        { Simple upper case translation }
  101. end;
  102.  
  103. procedure VerifyAinteger;
  104. begin
  105.   with DataPad do
  106.     if ((Idata=0) or (Idata>200)) then
  107.       MakeErrMsg (1,200);
  108. end;
  109.  
  110. {$F-}
  111.  
  112. { ======================== GetUserDataEntry ================================= }
  113. { The major configurations for all menus go here.  The program first clears   }
  114. { all RECORD values to $00.  The values below will set new values. Therefore, }
  115. { setting RECORD values to "false", nil, or the like is not necessary.        }
  116. { --------------------------------------------------------------------------- }
  117.  
  118. { Code saving utilities: }
  119. procedure GetDataWndw (Index: word);
  120. begin
  121.   DWI := Index;
  122.   TopDataWndw := DataWndw^[DWI];
  123. end;
  124.  
  125. procedure SaveDataWndw;
  126. begin
  127.   DataWndw^[DWI] := TopDataWndw;
  128. end;
  129.  
  130. procedure GetDataEntry (Index: word);
  131. begin
  132.   DEI := Index;
  133.   TopEntry := DataEntry^[DEI];
  134. end;
  135.  
  136. procedure SaveDataEntry;
  137. begin
  138.   DataEntry^[DEI] := TopEntry;
  139. end;
  140.  
  141. procedure GetDataEntryStats;
  142. begin
  143.  
  144.   { ------------- Set up your PULL-DOWN Data Windows here: ------------------ }
  145.   { Justification will default with numbers right justified and string to  }
  146.   { the left if none is specified.                                         }
  147.  
  148.   with TopDataWndw,TopDataWndw.Entry do
  149.     begin
  150.  
  151.       GetDataWndw (ord(aByteDW));         { Just gets cleared TopDataWndw }
  152.       VarAddr       := @aByte;
  153.     { TypeOfData    := Bytes; }           { This is the default }
  154.       Field         := 3;
  155.     { JustifyOutput := Right; }           { This is the default }
  156.     { MsgLineNum    := ord(DE_ML); }      { This is the default }
  157.     { HelpWndwNum   := ord(DataWndwHW); } { This is the default }
  158.       SaveDataWndw;                       { Saves it in the heap }
  159.  
  160.   end;  { with }
  161.  
  162.   { ------------------------ Work Window Data Entry ------------------------- }
  163.   AutoTab := true;    { After entry, tabs to next one in sequence }
  164.   with DataPad do
  165.     if QvideoMode=Mono then
  166.          Hattr := LightGrayBG
  167.     else Hattr := White+CyanBG; { Optional Attribute of Data Entry hilite }
  168.                                 { Use SameAttr if not desired }
  169.   with TopEntry do
  170.     begin
  171.  
  172.       GetDataEntry (ord(aIntegerDE));
  173.       VarAddr     := @aInteger;
  174.       TypeOfData  := Integers;
  175.       Row         := 2;
  176.       Col         := 11;
  177.       Field       := 4;
  178.       MaxField    := 3;
  179.       CheckRangeProc := @VerifyAinteger;
  180.     { MsgLineNum  := ord(DE_ML); }      { This is the default }
  181.     { HelpWndwNum := ord(DataWndwHW); } { This is the default }
  182.       SaveDataEntry;
  183.  
  184.     end;
  185.  
  186. end;  { procedure GetDataEntryStats }
  187.  
  188. { =================== Data Entry Initialization Code ======================== }
  189. { The following code initializes all of the stats for the data entry windows  }
  190. { and the work window data entry fields.  There is no need to edit this       }
  191. { Except for the default colors in SetDefaultColors.                          }
  192. { --------------------------------------------------------------------------- }
  193.  
  194. procedure AllocateHeap;
  195. begin
  196.   if HeapOK (sizeof(DataWndws)) then
  197.     GetMem (DataWndw,SizeOf(DataWndws));
  198.   fillchar (DataWndw^,SizeOf(DataWndws),0);
  199.   if HeapOK (sizeof(DataEntries)) then
  200.     GetMem (DataEntry,SizeOf(DataEntries));
  201.   fillchar (DataEntry^,SizeOf(DataEntries),0);
  202. end;
  203.  
  204. procedure SetDefaultColors;
  205. begin
  206.   { ------------------ Set up your colors and borders here: ---------------- }
  207.   if QvideoMode=Mono then
  208.     begin
  209.       DataEntryIattr := LightGray;         { Input  attribute }
  210.       DataEntryOattr := White;             { Output attribute }
  211.       DataWndwIattr  := White;             { Input  attribute }
  212.       DataWndwOattr  := LightGrayBG;       { Output attribute }
  213.     end
  214.   else
  215.     begin
  216.       DataEntryIattr := Yellow+MagentaBG;  { Input  attribute }
  217.       DataEntryOattr := Black+LightGrayBG; { Output attribute }
  218.       DataWndwIattr  := Black+BrownBG;     { Input  attribute }
  219.       DataWndwOattr  := Yellow+BlackBG;    { Output attribute }
  220.     end;
  221.   DataWndwBattr  := Black+BrownBG;     { Border attribute }
  222.   DataWndwBrdr   := HdoubleBrdr;
  223. end;
  224.  
  225. procedure InitDataColors;
  226. var  i: word;
  227. begin
  228.   for i:=1 to NumOfDataWndws do
  229.     with TopDataWndw,TopDataWndw.Entry do
  230.       begin
  231.         GetDataWndw (i);
  232.         Iattr := DataWndwIattr;   { Input  attribute }
  233.         Oattr := DataWndwOattr;   { Output attribute }
  234.         Battr := DataWndwBattr;   { Border attribute }
  235.         SaveDataWndw;
  236.       end;
  237.   for i:=1 to NumOfDataEntries do
  238.     with TopEntry do
  239.       begin
  240.         GetDataEntry (i);
  241.         Iattr := DataEntryIattr;  { Input  attribute }
  242.         Oattr := DataEntryOattr;  { Output attribute }
  243.         SaveDataEntry;
  244.       end;
  245. end;
  246.  
  247. function GetJustify (Justify: DirType; TOD: TypeOfDataType): DirType;
  248. begin
  249.   if Justify=NoDir then
  250.     begin
  251.       if TOD<=UserNums then
  252.            GetJustify := Right   { for nums }
  253.       else GetJustify := Left;   { for chars and strings }
  254.     end
  255.   else GetJustify:=Justify;
  256. end;
  257.  
  258. function GetSetName (SN: SetNames; TOD: TypeOfDataType): SetNames;
  259. begin
  260.   if SN=NoSet then
  261.     case TOD of
  262.       Bytes,Words:         GetSetName := UnsignedSet;
  263.       ShortInts..LongInts: GetSetName := SignedSet;
  264.       Reals:               GetSetName := RealSet;
  265.     else
  266.       GetSetName := CharSet;
  267.     end
  268.   else GetSetName:=SN;
  269. end;
  270.  
  271. procedure InitDataDefaults;
  272. var i: word;
  273. begin
  274.   for i:=1 to NumOfDataWndws do
  275.     with TopDataWndw,TopDataWndw.Entry do
  276.       begin
  277.         GetDataWndw (i);
  278.         Border  := DataWndwBrdr;
  279.         SetName := GetSetName (SetName,TypeOfData);
  280.         Row := 1;
  281.         Col := 2;
  282.         if MaxField=0 then
  283.           MaxField := Field;
  284.         JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
  285.         if MsgLineNum=0 then
  286.           MsgLineNum := ord(DW_ML);
  287.         if HelpWndwNum=0 then
  288.           HelpWndwNum := ord(DataWndwHW);
  289.         SaveDataWndw;
  290.       end;
  291.   for i:=1 to NumOfDataEntries do
  292.     with TopEntry do
  293.       begin
  294.         GetDataEntry (i);
  295.         SetName := GetSetName (SetName,TypeOfData);
  296.         if MaxField=0 then
  297.           MaxField := Field;
  298.         JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
  299.         if MsgLineNum=0 then
  300.           MsgLineNum := ord(DE_ML);
  301.         if HelpWndwNum=0 then
  302.           HelpWndwNum := ord(DataWndwHW);
  303.         SaveDataEntry;
  304.       end;
  305. end;
  306.  
  307. BEGIN
  308.   AllocateHeap;
  309.   SetDefaultColors;
  310.   InitDataColors;
  311.   {$ifdef UseMsgLineCode }
  312.   GetErrMsgs;
  313.   {$endif }
  314.   GetDataEntryStats;
  315.   InitDataDefaults;
  316. END.
  317.  
  318.